home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Suzy B Software 2
/
Suzy B Software CD-ROM 2 (1994).iso
/
adult_ed
/
grapher
/
graph
/
grapher.pas
next >
Wrap
Pascal/Delphi Source File
|
1995-05-02
|
60KB
|
1,783 lines
program Grapher(input, output);
const
Pi = 3.14159265;
ClrScr = 69; {Clear screen and home the cursor}
Cursor_on = 101; {Turn blinking cursor on}
Cursor_off = 102; {Turn blinking cursor off}
{$I GEMCONST.PAS}
type
Str7 = string[7];
Draw_Type = (Redraw, No_Grid, Old_Grid);
Grid_Type = (Rectangular, Polar, Trigonometric);
Res_Type = (Low, Med, Hi);
TokenType = (Numeric, Character);
NodePtr = ^Node;
Node = record
Link: NodePtr;
case NodeType: TokenType of
Numeric: (Value: real);
Character: (Code: char;
Priority: 0..5)
end;
Screen_Type = packed array [0..31999] of byte;
Screen_Ptr = ^Screen_Type;
{$I GEMTYPE.PAS}
var
InFix: Str255; {Infix expression}
TempPtr, {Temporary pointer}
PostFix: NodePtr; {Postfix expression}
X_Scale, {Scale on X-axis}
Y_Scale: real; {Scale used on graph grid}
Color: integer; {Color of graph}
Draw: Draw_Type; {Grid drawing option}
Grid: Grid_Type; {Type of grid}
Event: integer; {Holds Get_Event value}
DummyMsg: Message_Buffer; {Dummy variable used in Get_Event call}
D: integer; {Dummy variable used in Get_Event call}
{The following variables are accessed as global variables}
Res: Res_Type; {Screen resolution}
X_Pix, {Number of pixels in horizontal direction}
Y_Pix, {Number of pixels in vertical direction}
X_Center, {Center of screen horizontally}
Y_Center, {Center of screen vertically}
Num_Color: integer; {Number of colors available for graph}
SF: real; {Scaling factor need to compensate for screen
aspect ratio}
Display_Area, {Pointer to display area in memory}
Temp_Screen: Screen_Ptr;{Used to save a graph display}
GEM_Interface: boolean; {TRUE if user selects GEM-based interface}
GridStr, {This and next four are used to store user}
DrawStr, {input for grid type, grid drawing option,}
ColorStr, {graph color, }
XStr, {X-scale, and }
YStr: Str255; {Y-scale. }
{$I GEMSUBS.PAS}
{**************** Out_Escape ******************
* *
* Send escape codes that control the cursor. *
* *
* Called by: Initialization, *
* Get_Expression, *
* Get_Graph_Parameters_OK *
* *
* In parameter: Ascii code of the character *
* following escape code *
************************************************}
procedure Out_Escape(c : integer);
procedure bconout(device, c:integer);
BIOS(3);
begin
bconout(2, 27); {The escape character}
bconout(2, c)
end; {Out_Escape}
{************* Initialization *****************
* *
* Sets the value of various global screen *
* parameters based on the screen resolution. *
* Also sets initial default values of graph *
* parameters: grid scales, color, and *
* expression to be graphed. *
* *
* Called by: MAIN DRIVER *
* *
* All variables used in this procedure are *
* accessed as globals *
************************************************}
procedure Initialization;
var
AlertStr: Str255; {Alert box string}
Blanks: string[25]; {A string of blanks}
Num: integer; {Dummy value used in Alert Box call}
Scr_Res: integer; {Holds screen resolution value}
Dummy: char;
{------------- Physical Screen -------------
| |
| Returns pointer to physical screen area. |
| |
| Called by: MAIN DRIVER |
---------------------------------------------}
function Physical_Screen: Screen_Ptr;
XBIOS(2);
{------------- Get Resolution --------------
| |
| Returns 0, 1, or 2 indicating current |
| screen resolution low, med, or high. |
| |
| Called by: MAIN DRIVER |
---------------------------------------------}
function Get_Res : Integer;
XBIOS(4);
begin
{ Set up screen parameters based on display resolution. }
Scr_Res := Get_Res;
case Scr_Res of
0 : begin
Res := Low;
X_Pix := 320;
Y_Pix := 200;
SF := 0.869;
Num_Color := 15
end; {0}
1 : begin
Res := Med;
X_Pix := 640;
Y_Pix := 200;
SF := 0.434;
Num_Color := 3
end; {1}
2 : begin
Res := Hi;
X_Pix := 640;
Y_Pix := 400;
SF := 0.869;
Num_Color := 1
end; {3}
end; {case}
{ Print Copyright Message }
Out_Escape(ClrScr);
if Res = Low then
Blanks := ' '
else
Blanks := ' ';
writeln(Blanks,' Grapher');
writeln(Blanks,' by Delmar Searls');
writeln;
writeln(Blanks,' (Parts of this product are');
writeln(Blanks,'Copyright (c) 1986, OSS & CCD');
writeln(Blanks,' Used by permission of OSS)');
{ Let user select type of interface }
AlertStr := '[2]';
AlertStr := concat(AlertStr, '[ Choose a |');
AlertStr := concat(AlertStr, ' text-oriented |');
AlertStr := concat(AlertStr, ' or GEM-based |');
AlertStr := concat(AlertStr, ' interface. ]');
AlertStr := concat(AlertStr, '[ Text | GEM ]');
Num := Do_Alert(AlertStr, 0);
if Num = 1 then
GEM_Interface := FALSE
else
GEM_Interface := TRUE;
Out_Escape(ClrScr);
{ Set clipping boundaries and find coordinates of center of display. }
Set_Clip(0,0,X_Pix,Y_Pix);
X_Center := X_Pix DIV 2;
Y_Center := Y_Pix DIV 2;
{ Set up initial default values }
GridStr := 'R';
DrawStr := '1';
ColorStr := '1'; Color := 1;
XStr := '1'; X_Scale := 1;
YStr := '1'; Y_Scale := 1;
InFix := 'SIN(X)';
Display_Area := Physical_Screen;
new(Temp_Screen)
end; {Initialization)
{**************** Str_to_Num ******************
* *
* Converts a string representation of a number *
* to the numeric representation. *
* *
* Called by: Next_Token, Get_Scale, *
* Get_Graph_Parameters_OK *
* *
* In parameter: The string representation *
* Out parameter: Syntax error flag *
************************************************}
function Str_to_Num(NumStr {in}: Str255;
var Syntax_Error {out}: boolean): Real;
var
Integer_Part, {Integer part of number}
Fraction_Part, {Fraction part of number}
Power_of_Ten: real; {Used in finding fraction part}
DP, {Position of decimal point}
Num_Int_Digits, {Number of digits in integer part}
Num_Frac_Digits, {Number of digits in fractional part}
I: integer; {Loop counter}
begin
{ Initialize variables. }
Integer_Part := 0;
Fraction_Part := 0;
Power_of_Ten := 1;
{ Determine number of digits in integer part and fraction part. }
DP := pos('.', NumStr);
if DP = 0 then begin { string represents an integer }
Num_Int_Digits := length(NumStr);
Num_Frac_Digits := 0
end {if}
else begin { string represents a real }
Num_Int_Digits := DP-1;
Num_Frac_Digits := length(NumStr)-DP
end; {else}
{ Convert integer part to numeric form. }
for I := 1 to Num_Int_Digits do begin
Integer_Part := 10*Integer_Part + ord(NumStr[1]) - ord('0');
delete(NumStr,1,1)
end; {for}
if NumStr <> '' then { delete decimal point from string }
delete(NumStr,1,1);
{ Convert fraction part (if any) to numeric form. }
if Num_Frac_Digits > 0 then { first check for extra decimal point }
if pos('.', NumStr) = 0 then begin { conversion process }
for I := 1 to Num_Frac_Digits do begin
Fraction_Part := 10*Fraction_Part + ord(NumStr[1]) - ord('0');
Power_of_Ten := 10*Power_of_Ten;
delete(NumStr,1,1)
end; {for}
Fraction_Part := Fraction_Part/Power_of_Ten
end {if}
else
Syntax_Error := TRUE;
Str_to_Num := Integer_Part + Fraction_Part
end; {Str_to_Num}
{************** Convert ***********************
* *
* This function converts the input expression *
* from infix to postfix notation. A pointer *
* to the postfix expression is returned as the *
* value of Convert. *
* *
* Called by: Get_Expression *
* *
* In parameter: The infix expression *
* Out parameter: Syntax error flag *
************************************************}
function Convert(InString {in}: Str255;
var Syntax_Error {out}: boolean): NodePtr;
var
TempStr: Str255; {Temporary storage of Infix expression}
PostFix, {Pointer to the postfix expression}
Tail, {Pointer to last token in postfix expression}
Token, {A token to be added to postfix expression}
TOS: NodePtr; {Pointer to top of stack used in conversion}
I, {Loop counter}
L: integer; {Length of InFix expression}
Previous_Token: char; {Denotes the type of the previous token. This
has a value of '(' for right parenthesis, and
a 'N' if previous token was numeric. Numeric
tokens are numbers, 'X', and ')'. A code of
'F' indicates a function token. Otherwise
this identifier is assigned the null character. }
{------------ Next_Token -------------------
| |
| This function removes the next item from |
| the infix expression and returns the |
| corresponding token. |
| |
| Called by: Convert |
| |
| In/Out parameter: The infix expression |
| Previous token |
| Out parameter: Syntax error flag |
---------------------------------------------}
function Next_Token(var InFix {in/out}: Str255;
var Previous_Token: char;
var Syntax_Error {out}: boolean): NodePtr;
var
Token: NodePtr; {The new token}
TStr: Str255; {Stores numeric operand in string form}
TChar: char; {Token code for non-numeric tokens}
T: integer; {Temporary storage for token priority}
begin
{ Get and initialize token node. }
new(Token);
Token^.Link := NIL;
while InFix[1] = ' ' do { remove leading blanks }
delete(InFix,1,1);
TStr := InFix[1]; { Transfer first character of infix to TStr. }
delete(InFix,1,1);
if TStr[1] in ['0'..'9','.'] then begin { Token is a number. }
Token^.NodeType := Numeric;
{ Read the number as a string of valid numeric characters. }
while (InFix <> '') and (InFix[1] in ['.','0'..'9']) do begin
TStr := concat(TStr, InFix[1]);
delete(InFix,1,1)
end; {while}
{ Convert string representation to numeric. }
Token^.Value := Str_to_Num(TStr, Syntax_Error);
{ Do a little error checking. A number cannot directly follow
another numeric token or a function token. }
if NOT Syntax_Error then
if (Previous_Token = 'N') OR (Previous_Token = 'F') then
Syntax_Error := TRUE
else {reset previous token code}
Previous_Token := 'N'
end {if}
else begin { Token is character type token. }
Token^.NodeType := Character;
TChar := TStr[1];
Token^.Code := TChar;
{ Determine priority of token }
case TChar of
'X','(',')': Token^.Priority := 0;
'+': Token^.Priority := 1;
'-': if Previous_Token = '(' then begin
Token^.Priority := 3;
TChar := '~';
Token^.Code := '~'
end {if}
else
Token^.Priority := 1;
'*','/': Token^.Priority := 2;
'^': Token^.Priority := 4;
{ Also check for syntax errors in function tokens. }
'A': if (Length(InFix) > 1) and (InFix[1] = 'B')
and (InFix[2] = 'S') then begin
Token^.Priority := 5;
delete(InFix,1,2)
end {if}
else
Syntax_Error := TRUE;
'C': if (Length(InFix) > 1) and (InFix[1] = 'O')
and (InFix[2] = 'S') then begin
Token^.Priority := 5;
delete(InFix,1,2)
end {if}
else
Syntax_Error := TRUE;
'E': if (Length(InFix) > 1) and (InFix[1] = 'X')
and (InFix[2] = 'P') then begin
Token^.Priority := 5;
delete(InFix,1,2)
end {if}
else
Syntax_Error := TRUE;
'L': if (Length(InFix) > 0) and (InFix[1] = 'N') then begin
Token^.Priority := 5;
delete(InFix,1,1)
end {if}
else
Syntax_Error := TRUE;
'S': if (Length(InFix) > 1) and (InFix[1] = 'I')
and (InFix[2] = 'N') then begin
Token^.Priority := 5;
delete(InFix,1,2)
end {if}
else if (Length(Infix)>1) and (Infix[1] = 'Q')
and (Infix[2] = 'R') then begin
Token^.Priority := 5;
Token^.Code := 'R';
delete(InFix,1,2)
end {else if}
else
Syntax_Error := TRUE;
'T': if (Length(Infix) > 1) and (InFix[1] = 'A')
and (InFix[2] = 'N') then begin
Token^.Priority := 5;
delete(InFix,1,2)
end {if}
else
Syntax_Error := TRUE;
OTHERWISE: Syntax_Error := TRUE { Since token was not in list }
end; {case}
if NOT Syntax_Error then begin
{ Do a little error checking. }
T := Token^.Priority;
if ((T = 5) OR (TChar = 'X') OR (TChar = '('))
AND (Previous_Token = 'N') then
Syntax_Error := TRUE
else if ((T = 5) OR (TChar = 'X'))
AND (Previous_Token = 'F') then
Syntax_Error := TRUE
else if ((T = 1) OR (T = 2) OR (T = 4) OR (TChar = ')'))
AND (Previous_Token <> 'N') then
Syntax_Error := TRUE;
{ Reset previous token code. }
if NOT Syntax_Error then
if Token^.Nodetype = Numeric then
Previous_Token := 'N'
else if TChar in ['X',')'] then
Previous_Token := 'N'
else if TChar = '(' then
Previous_Token := '('
else if T = 5 then
Previous_Token := 'F'
else
Previous_Token := chr(0)
end {if}
end; {else}
Next_Token := Token
end; {Next_Token}
{------------------ Append -----------------
| |
| This procedure appends the input token to |
| the postfix expression. |
| |
| Called by: Convert |
| |
| In parameter: The token |
| In/Out parameter: Pointer to last token |
| in postfix expression |
---------------------------------------------}
procedure Append(var Tail {in/out}: NodePtr;
Item {in}: NodePtr);
var Temp: NodePtr;
begin
if Item^.Link <> NIL then {Item is on stack, append copy to postfix. }
new(Temp)
else { The item itself is appended to postfix. }
Temp := Item;
Temp^ := Item^;
Tail^.Link := Temp;
Tail := Temp;
Temp^.Link := NIL
end; {Append}
{----------------- Push --------------------
| |
| Push a token onto the stack |
| |
| Called by: Convert |
| |
| In parameter: The token |
| In/Out parameter: The top of stack ptr |
---------------------------------------------}
procedure Push(var TOS {in/out}: NodePtr;
Item {in}: NodePtr);
begin
Item^.Link := TOS;
TOS := Item
end;
{------------------- Pop --------------------
| |
| Delete the top element from the stack. |
| |
| Called by: Convert |
| |
| In/Out parameter: The top of stack ptr |
---------------------------------------------}
procedure Pop(var TOS {in/out}: NodePtr);
var
Temp: NodePtr;
begin
Temp := TOS;
TOS := TOS^.Link;
dispose(Temp)
end; {Pop}
{******** Convert code starts here *******}
begin
TempStr := InString;
Syntax_Error := FALSE;
Previous_Token := '(';
{ Create 'NULL' node on stack. }
new(TOS);
TOS^.NodeType := Character;
TOS^.Priority := 0;
TOS^.Code := '@';
TOS^.Link := NIL;
{Create a dummy head node. }
new(PostFix);
Tail := PostFix;
{ Process the user's infix expression. }
while (Length(InString) > 0) and not Syntax_Error do begin
Token := Next_Token(InString, Previous_Token, Syntax_Error);
if not Syntax_Error then begin
{ Numbers and variable X are immediately appended to postfix. }
if Token^.NodeType = Numeric then
Append(Tail, Token)
else if Token^.Code = 'X' then
Append(Tail, Token)
{ Left parenthesis is pushed onto the stack. }
else if Token^.Code = '(' then
Push(TOS, Token)
{ When a right parenthesis is encountered, operators are pulled
from the stack and appended to postfix until the corresponding
left parenthesis is encountered. The left parenthesis is
pulled from the stack, and both parentheses are discarded. }
else if Token^.Code = ')' then begin
while (TOS^.Code <> '(') and (TOS^.Code <> '@') do begin
Append(Tail, TOS);
Pop(TOS)
end; {while}
if TOS^.Code = '@' then
Syntax_Error := TRUE
else
Pop(TOS)
end {else if}
{ The only thing left is operators. Operators of higher priority,
if any, are pulled from the stack and appended to postfix. The
current operator is then pushed onto the stack. }
else begin
while Token^.Priority <= TOS^.Priority do begin
Append(Tail, TOS);
Pop(TOS)
end; {while}
Push(TOS, Token)
end {else}
end {if}
end; {while}
if Syntax_Error then begin { Print syntax error message if needed. }
if GEM_Interface then begin
Out_Escape(ClrScr);
writeln('Y = ',TempStr)
end; {if}
L := length(TempStr) - length(InString) + 4;
for I := 1 to L do
write(' ');
writeln('^');
writeln('Syntax error!')
end {if}
{ Remove the remaining operators from the stack and append to postfix. }
else begin
while TOS^.Code <> '@' do begin
if TOS^.Code = '(' then begin
Syntax_Error := TRUE;
if GEM_Interface then
Out_Escape(ClrScr);
writeln('Unmatched Left Parenthesis!')
end;
Append(Tail, TOS);
Pop(TOS)
end; {while}
Pop(TOS) { Pull NULL node from stack }
end; {else}
Convert := PostFix^.Link;
dispose(PostFix)
end; {Convert}
{**************** Evaluate ********************
* *
* Evaluates the Postfix expression for the *
* value of X passed to it. *
* *
* Called by: Get_Expression, Rect_Graph, *
* and Polar_Graph *
* *
* In parameters: The postfix expression and *
* The value of X *
* Out parameters: Postfix error flag and *
* Undefined result flag *
************************************************}
function Evaluate(Head {in}: NodePtr;
X {in}: real;
var PostFix_Error {out},
Undefined {out}: boolean): real;
var
TOS: 0..100;
Stack: array [1..100] of real;
Cosine_Val: real;
Temp: integer;
begin
{ Initialize flags and data stack. }
PostFix_Error := FALSE;
Undefined := FALSE;
TOS := 0;
{ Process postfix expression }
while (Head <> NIL) and not PostFix_Error and not Undefined do begin
{ Push numbers onto the stack, }
if Head^.NodeType = Numeric then begin
TOS := TOS + 1;
Stack[TOS] := Head^.Value
end {if}
{ or push the value of the variable onto the stack, }
else if Head^.Code = 'X' then begin
TOS := TOS + 1;
Stack[TOS] := X
end {else if}
{ or apply negation operator, }
else if Head^.Priority = 3 then
if TOS>0 then
Stack[TOS] := -Stack[TOS]
else
PostFix_Error := TRUE
{ or apply function to TOS element, }
else if Head^.Priority = 5 then
if TOS>0 then
case Head^.Code of
'A': Stack[TOS] := ABS(Stack[TOS]);
'C': Stack[TOS] := COS(Stack[TOS]);
'E': if Stack[TOS] < -50 then
Stack[TOS] := 0
else if Stack[TOS] < 50 then
Stack[TOS] := EXP(Stack[TOS])
else
Undefined := TRUE;
'L': if Stack[TOS] > 0 then
Stack[TOS] := LN(Stack[TOS])
else
Undefined := TRUE;
'R': if Stack[TOS] >= 0 then
Stack[TOS] := SQRT(Stack[TOS])
else
Undefined := TRUE;
'S': Stack[TOS] := SIN(Stack[TOS]);
'T': begin
Cosine_Val := COS(Stack[TOS]);
if ABS(Cosine_Val) > 0.000001 then
Stack[TOS] := SIN(Stack[TOS])/COS(Stack[TOS])
else
Undefined := TRUE
end {case option}
end {case}
else
PostFix_Error := TRUE
{ or else the token is a binary operator which is applied to top
two stack elements and the result replaces both of them. }
else if TOS>1 then begin
TOS := TOS - 1;
case Head^.Code of
'+': Stack[TOS] := Stack[TOS] + Stack[TOS+1];
'-': Stack[TOS] := Stack[TOS] - Stack[TOS+1];
'*': Stack[TOS] := Stack[TOS] * Stack[TOS+1];
'/': if ABS(Stack[TOS+1]) > 0.000001 then
Stack[TOS] := Stack[TOS] / Stack[TOS+1]
else
Undefined := TRUE;
{ The program can handle two types of exponentiation. If the
base (TOS) is positive, the normal process of using EXP and LN
functions is used. If the base is negative and the exponent
is an integer, then we have to apply some algebraic trickery
first. If the base has a value of zero, the result is set
to zero as well. }
'^': if Stack[TOS] > 0 then
Stack[TOS] := EXP(Stack[TOS+1]*LN(Stack[TOS]))
else if Stack[TOS] < 0 then begin
Temp := round(Stack[TOS+1]);
if abs(Temp - Stack[TOS+1]) < 0.000001 then begin
Stack[TOS] := EXP(Stack[TOS+1]*LN(-Stack[TOS]));
if Odd(Temp) then
Stack[TOS] := -Stack[TOS]
end {if}
else
Undefined := TRUE
end {else if}
else
Stack[TOS] := 0
end {case}
end {if}
{ If we get this far, then postfix token is invalid. Not likely to
happen. }
else
PostFix_Error := TRUE;
Head := Head^.Link { Move to next token in postfix. }
end; {while}
{ At the end, there should be only one element remaining on the stack,
namely the final result. Otherwise, the postfix expression is invalid.
We skip this if the function is undefined for the current value of X. }
if not Undefined then begin
if TOS = 1 then
Evaluate := Stack[TOS]
else
PostFix_Error := TRUE;
{ Print error message if necessary. }
if PostFix_Error then begin
if GEM_Interface then
Out_Escape(ClrScr);
writeln('Postfix error detected!');
writeln;
writeln('This is usually caused by too few');
writeln('operators. Check for missing arithmetic');
writeln('symbols; especially multiplication "*".')
end {if}
end {if}
end; {Evaluate}
{************** Get Expression ****************
* *
* This procedure asks the user to enter the *
* expression to be graphed. It is entered in *
* normal infix notation and converted to *
* postfix. *
* *
* Called by: MAIN DRIVER *
* *
* Out Parameter: The postfix expression *
* In/Out parameter: The infix expression *
************************************************}
procedure Get_Expression(var InFix {in/out}: Str255;
var PostFix {out}: NodePtr);
var
J, {Loop counter}
Last: integer; {Index of last character in infix expression}
Temp: real; {Used in checking for postfix errors}
TempStr: Str255; {Temporary storage of infix expression}
Dummy,
Syntax_Error, {TRUE if error found during conversion to postfix}
PostFix_Error: boolean; {TRUE if error found during evaluation}
Dialog: Dialog_Ptr; {Pointer to dialog box}
Pushed, {Stores way in which user exited dialog box}
Prompt, {Points to prompt in dialog box}
User_Input, {Points to user input item in dialog box}
Quit_Btn, {Quit button in dialog box}
Ok_Btn: integer; {Ok button in dialog box}
begin
if NOT Gem_Interface then begin
{ Print the instructions and the default infix expression. }
Out_Escape(ClrScr);
Out_Escape(Cursor_On);
writeln;
writeln('Enter the expression you want graphed.');
writeln('(Enter "Q" to QUIT)');
writeln;
writeln('Y = ',InFix);
end; {if}
{ Get a valid infix expression from the user. }
repeat
if GEM_Interface then begin
if Res = Low then
Dialog := New_Dialog(4,0,0,38,5)
else
Dialog := New_Dialog(4,0,0,78,5);
Prompt := Add_DItem(Dialog,G_Text,None,1,1,2,1,0,256*Black);
Set_DText(Dialog,Prompt,'Y=',3,TE_Center);
if Res = Low then begin
User_Input := Add_DItem(Dialog,G_FText,Editable,
3,1,34,1,0,256*Black|128);
Set_DEdit(Dialog,User_Input,'__________________________________',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
Infix,3,TE_Left)
end {if}
else begin
User_Input := Add_DItem(Dialog,G_FText,Editable,
3,1,74,1,0,256*Black|128);
Set_DEdit(Dialog,User_Input,
'__________________________________________________________________________',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
Infix,3,TE_Left)
end; {else}
Quit_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
1,3,6,1,0,0);
Set_DText(Dialog,Quit_Btn,'QUIT',3,TE_Center);
Ok_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
9,3,6,1,0,0);
Set_DText(Dialog,Ok_Btn,' OK ',3,TE_Center);
Center_Dialog(Dialog);
Show_Mouse;
Pushed := Do_Dialog(Dialog,User_Input);
End_Dialog(Dialog);
Hide_Mouse;
Out_Escape(ClrScr);
Delete_Dialog(Dialog);
if Pushed = Quit_Btn then
TempStr := 'Q'
else
Get_DEdit(Dialog,User_Input,TempStr)
end {if}
else begin
writeln;
write('Y = ');
readln(TempStr)
end; {else}
Syntax_Error := FALSE;
PostFix_Error := FALSE;
if TempStr <> '' then begin
{Remove trailing blanks}
InFix := TempStr;
Last := Length(InFix);
while (Last > 0) and (InFix[Last] = ' ') do begin
delete(InFix,Last,1);
Last := Last - 1
end; {while}
{Convert to all uppercase}
for J := 1 to Last do
if InFix[J] in ['a'..'z'] then
InFix[J] := chr(ord(InFix[J])-32)
end; {if}
If InFix <> 'Q' then begin { Convert infix to postfix. }
PostFix := Convert(InFix, Syntax_Error);
if NOT Syntax_Error then { Check for postfix error. }
Temp := Evaluate(PostFix, 1.1, PostFix_Error, Dummy)
end {if}
until NOT(Syntax_Error or PostFix_Error);
if NOT GEM_Interface then
Out_Escape(Cursor_Off)
end; {Get}
{********** Get Graph Parameters OK ***********
* *
* Get the grid scale, the color of the graph, *
* and the desired grid drawing option. *
* *
* Called by: MAIN DRIVER *
* *
* Out parameters: Grid type, X & Y scales, *
* color, and grid drawing option. *
* *
* Global variables accessed: Res, Num_Color *
************************************************}
function Get_Graph_Parameters_OK(var Grid {out}: Grid_Type;
var X_Scale {out}: real;
var Y_Scale {out}: real;
var Color {out}: integer;
var Draw {out}: Draw_Type): boolean;
var
I: integer; {Loop counter}
TempStr: Str255; {Temporary string representation}
Temp: real; {Temporary numeric representation}
Syntax_Error: boolean; {True if entry is invalid}
Dialog: Dialog_Ptr; {Pointer to dialog box}
Button: array [1..15] of integer; {Dialog box buttons}
Pushed: integer; {Indicates which button was selected}
Prompt: integer; {Pointer to prompt in dialog box}
{-------------- Select Color ---------------
| |
| Select color for graph line. |
| |
| Called by: Get_Graph_Parameters_OK |
| |
---------------------------------------------}
procedure Select_Color;
var
I : integer; {Loop counter}
begin
if GEM_Interface then begin
Dialog := New_Dialog(16,0,0,8,18);
Prompt := Add_DItem(Dialog,G_Text,None,1,1,6,1,0,256*Black);
Set_DText(Dialog,Prompt,'Color?',3,TE_Center);
for I := 1 to Num_Color do
Button[I] := Add_DItem(Dialog,G_Box,Selectable|Exit_Btn,
2,I+1,4,1,0,112+I);
Center_Dialog(Dialog);
Show_Mouse;
Pushed := Do_Dialog(Dialog,0);
End_Dialog(Dialog);
Hide_Mouse;
Out_Escape(ClrScr);
Delete_Dialog(Dialog);
for I := 1 to Num_Color do
if Pushed = Button[I] then
Color := I
end {if}
else begin
Out_Escape(ClrScr);
for I := 1 to Num_Color do begin
Line_Color(I);
writeln(I:2,' ');
line(24, 8*I-4, 300, 8*I-4)
end; {for}
writeln;
repeat
Syntax_Error := FALSE;
write('Graph color <',ColorStr,'>: '); readln(TempStr);
if TempStr <> '' then begin
for I := 1 to length(TempStr) do
if not (TempStr[I] in ['0'..'9']) then
Syntax_Error := TRUE;
if not Syntax_Error then begin
Temp := Str_to_Num(TempStr, Syntax_Error);
if (Temp < 1) or (Temp > Num_Color) then
Syntax_Error := TRUE
else begin
ColorStr := TempStr;
Color := round(Temp)
end {else}
end {if}
end {if}
until not Syntax_Error
end {else}
end; {Select_Color}
{---------------- Get Scale ----------------
| |
| Get the scale for the X or Y axis. |
| |
| Called by: Get_Graph_Parameters_OK |
| |
| In parameter: Which axis ('X' or 'Y') |
| Out parameters: The scale in both numeric |
| and string representations |
| |
| TempStr, Temp, and Syntax_Error are used |
| as globals from calling procedure. |
---------------------------------------------}
procedure Get_Scale(Axis {in}: char;
var XYStr {out}: Str255;
var XY_Scale {out}: real);
var
I: integer; {Loop counter}
begin
if GEM_Interface then begin
Dialog := New_Dialog(9,0,0,11,20);
Prompt := Add_DItem(Dialog,G_Text,None,1,1,9,1,0,256*Black);
if Axis = 'X' then
Set_DText(Dialog,Prompt,'X-Scale',3,TE_Center)
else if Axis = 'Y' then
Set_DText(Dialog,Prompt,'Y-Scale',3,TE_Center)
else
Set_DText(Dialog,Prompt,'R-Scale',3,TE_Center);
for I := 1 to 8 do
Button[I] := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
3,2*I+2,5,1,0,0);
Set_DText(Dialog, Button[1], '0.5',3,TE_Center);
Set_DText(Dialog, Button[2], '1',3,TE_Center);
Set_DText(Dialog, Button[3], '2',3,TE_Center);
Set_DText(Dialog, Button[4], '5',3,TE_Center);
Set_DText(Dialog, Button[5], '10',3,TE_Center);
Set_DText(Dialog, Button[6], '20',3,TE_Center);
Set_DText(Dialog, Button[7], '50',3,TE_Center);
Set_DText(Dialog, Button[8], '100',3,TE_Center);
Center_Dialog(Dialog);
Show_Mouse;
Pushed := Do_Dialog(Dialog,0);
End_Dialog(Dialog);
Hide_Mouse;
Out_Escape(ClrScr);
Delete_Dialog(Dialog);
if Pushed = Button[1] then XY_Scale := 0.5
else if Pushed = Button[2] then XY_Scale := 1.0
else if Pushed = Button[3] then XY_Scale := 2.0
else if Pushed = Button[4] then XY_Scale := 5.0
else if Pushed = Button[5] then XY_Scale := 10.0
else if Pushed = Button[6] then XY_Scale := 20.0
else if Pushed = Button[7] then XY_Scale := 50.0
else XY_Scale := 100.0
end {if}
else begin
repeat
Syntax_Error := FALSE;
writeln;
write(Axis,'-Scale <',XYStr,'>: ');readln(TempStr);
if TempStr <> '' then begin
for I:= 1 to length(TempStr) do
if not (TempStr[I] in ['.','0'..'9']) then
Syntax_Error := TRUE;
if not Syntax_Error then
Temp := Str_to_Num(TempStr, Syntax_Error);
if not Syntax_Error then
if Temp > 100 then begin
writeln('Enter a value <= 100');
Syntax_Error := TRUE
end {if}
else begin
XYStr := TempStr;
XY_Scale := Temp
end {else}
end {if}
until not Syntax_Error
end {else}
end; {Get_Scale}
{---- Get Graph parameters starts here ----}
begin
{ Get Grid-type or QUIT }
if GEM_Interface then begin
Dialog := New_Dialog(5,0,0,14,13);
Prompt := Add_DItem(Dialog,G_Text,None,1,1,12,1,0,256*Black);
Set_DText(Dialog,Prompt,'Grid?',3,TE_Center);
for I := 1 to 4 do
Button[I] := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
4,2*I+1,6,1,0,0);
Set_DText(Dialog,Button[1],'RECT',3,TE_Center);
Set_DText(Dialog,Button[2],'TRIG',3,TE_Center);
Set_DText(Dialog,Button[3],'POLAR',3,TE_Center);
Set_DText(Dialog,Button[4],'QUIT',3,TE_Center);
Center_Dialog(Dialog);
Show_Mouse;
Pushed := Do_Dialog(Dialog,0);
End_Dialog(Dialog);
Hide_Mouse;
Out_Escape(ClrScr);
Delete_Dialog(Dialog);
if Pushed = Button[1] then TempStr := 'R'
else if Pushed = Button[2] then TempStr := 'T'
else if Pushed = Button[3] then TempStr := 'P'
else TempStr := 'Q'
end {if}
else begin
Out_Escape(Cursor_on);
Out_Escape(ClrScr);
writeln('Enter');
writeln;
writeln(' "R" for rectangular grid');
writeln;
writeln(' "P" for polar grid');
writeln;
writeln(' "T" for trigonometric grid');
writeln;
writeln(' "Q" for QUIT (or get new function)');
writeln;
writeln;
repeat
write('Grid type <',GridStr,'>: '); readln(TempStr);
if TempStr[1] in ['p','q','r','t'] then
TempStr[1] := chr(ord(TempStr[1])-32)
until (TempStr[1] in ['P', 'Q', 'R', 'T']) or (TempStr = '')
end; {else}
if TempStr = 'Q' then
Get_Graph_Parameters_OK := FALSE
else begin
if TempStr <> '' then
GridStr := TempStr;
Get_Graph_Parameters_OK := TRUE;
if GridStr = 'R' then
Grid := Rectangular
else if GridStr = 'P' then
Grid := Polar
else
Grid := Trigonometric;
{ Get grid scales }
if GEM_Interface then begin
if Grid = Rectangular then begin
Get_Scale('X', XStr, X_Scale);
Get_Scale('Y', YStr, Y_Scale)
end {if}
else if Grid = Polar then
Get_Scale('R', XStr, X_Scale)
else begin
X_Scale := Pi/2;
Get_Scale('Y', YStr, Y_Scale)
end {else}
end {if}
else begin
Out_Escape(ClrScr);
writeln('The origin is centered in the display');
write('area. You can adjust the ');
if Grid = Rectangular then begin
writeln('horizontal');
writeln('and vertical scales by entering the');
writeln('value corresponding to the first grid');
writeln('line. Integer values are recommended.');
writeln;
Get_Scale('X', XStr, X_Scale);
Get_Scale('Y', YStr, Y_Scale)
end {if}
else if Grid = Polar then begin
writeln('scale by');
writeln('entering the value of the radius of');
writeln('the first circle in the polar grid.');
writeln('Integer values are recommended.');
writeln;
Get_Scale('R', XStr, X_Scale)
end {else if}
else begin
writeln('vertical');
writeln('scale by entering the value of the');
writeln('first horizontal grid line. Integer');
writeln('values are recommended.');
writeln;
X_Scale := Pi/2;
XStr := '1.57079633';
Get_Scale('Y', YStr, Y_Scale)
end {else}
end; {else}
{ Get Graph Color }
if Res = Hi then
Color := Black
else
Select_Color;
{ Get Grid drawing option }
if GEM_Interface then begin
Dialog := New_Dialog(3,0,0,20,7);
for I := 1 to 3 do
Button[I] := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
1,2*I-1,18,1,0,0);
Set_DText(Dialog,Button[1],'Clear / New Grid',3,TE_Center);
Set_DText(Dialog,Button[2],'Clear / No Grid',3,TE_Center);
Set_DText(Dialog,Button[3],'Draw on old Grid',3,TE_Center);
Center_Dialog(Dialog);
Show_Mouse;
Pushed := Do_Dialog(Dialog,0);
End_Dialog(Dialog);
Hide_Mouse;
Out_Escape(ClrScr);
Delete_Dialog(Dialog);
if Pushed = Button[1] then
Draw := Redraw
else if Pushed = Button[2] then
Draw := No_Grid
else
Draw := Old_Grid
end {if}
else begin
Out_Escape(ClrScr);
writeln('Choose one of the following:');
writeln(' 1. Clear screen / Draw new grid');
writeln(' 2. Clear screen / NO GRID');
writeln(' 3. Draw graph on previous screen');
writeln;
repeat
Syntax_Error := FALSE;
write('Which option <',DrawStr,'>: '); readln(TempStr);
until (TempStr[1] in ['1','2','3']) or (TempStr = '');
if TempStr <> '' then begin
DrawStr := TempStr;
if DrawStr = '1' then
Draw := Redraw
else if DrawStr = '2' then
Draw := No_Grid
else
Draw := Old_Grid
end; {if}
Out_Escape(Cursor_Off)
end {else}
end {else}
end; {Get_Graph_Parameters_OK}
{************* Number to String ***************
* *
* Converts the number parameter to string *
* representation. *
* *
* Called by: Rect_Grid, Polar_Grid *
* *
* In parameter: The number *
* Out parameter: The corresponding string *
************************************************}
procedure Num_to_Str(N {in}: real;
var NumStr {out}: Str7);
var
Integer_Part, {Integer part of number}
Fraction_Part: integer; {Fractional part of number}
TempI, {Temporary integer string}
TempF: Str7; {Temporary fraction part string}
begin
{ Find integer and fraction parts. }
if Abs(round(N) - N) < 0.01 then begin
Integer_Part := round(N);
Fraction_Part := 0
end {if}
else begin
Integer_Part := trunc(N);
Fraction_Part := round((N-Integer_Part)*100)
end; {else}
{ Convert integer part to string representation. }
if Integer_Part = 0 then
TempI := '0'
else
TempI := '';
while Integer_Part <> 0 do begin
TempI := concat(chr(ord('0') + Integer_Part MOD 10), TempI);
Integer_Part := Integer_Part DIV 10
end; {while}
{ Convert fraction part to string representation. }
TempF := '';
if Fraction_Part <> 0 then begin
while Fraction_Part <> 0 do begin
TempF := concat(chr(ord('0') + Fraction_Part MOD 10), TempF);
Fraction_Part := Fraction_Part DIV 10
end; {while}
TempF := concat('.', TempF)
end; {if}
NumStr := concat(TempI, TempF) { Concatenate integer and fraction parts. }
end; {Num_to_Str}
{************* Restore Screen *****************
* *
* Restore saved screen to display area. *
* *
* Called by: Rect_Graph, Polar_Graph *
* *
* In parameters: Pointer to physical screen, *
* Screen storage area *
************************************************}
procedure Restore_Screen(Display {in},
Old_Screen {in}: Screen_Ptr);
var
I: integer; {Loop control}
begin
{$P-}
for I := 0 to 31999 do
Display^[I] := Old_Screen^[I]
{$P+}
end; {Restore_Screen}
{*********** Draw Rectangular Graph ***********
* *
* Draws a graph in a rectangular coordinate *
* system. *
* *
* Called by: MAIN DRIVER *
* *
* In Parameters: Function being graphed, *
* Grid scales, Color of graph, *
* Grid drawing option *
* *
* Globals accessed: X_Center, Y_Center, X_Pix, *
* SF, Display_Area and *
* Temp_Screen *
************************************************}
procedure Rect_Graph(The_Function {in}: NodePtr;
X_Scale, Y_Scale {in}: real;
Graph_Color {in}: integer;
Draw {in}: Draw_Type);
var
SX: integer; {Loop counter and screen X-coordinate}
SY, {Screen Y-coordinate}
X, Y, {Logical X, Y coordinates}
XPix_per_Unit, {Pixels per horizontal grid unit}
YPix_per_Unit: real; {Pixels per vertical grid unit}
Dummy,
Undefined, {TRUE if function is undefined for given X}
Line_to_Flag: boolean; {True if last logical point was plotted on screen}
{----------- Draw Rectangular Grid -----------
| |
| Draws and labels a rectangular grid. |
| |
| Called by: Rect_Graph |
| |
| In parameter: Grid scales, grid type |
| |
| Global parameters accessed: Res, X_Pix, |
| Y_Pix, X_Center, Y_Center, SF |
-----------------------------------------------}
procedure Rect_Grid(X_Scale, Y_Scale {in}: real;
Grid_Option: Grid_Type);
const
Pi_code = 227; {Code for Pi character}
var
X, Y: integer; {Loop control}
SX1, SX2, SY1, SY2, {Screen coordinates}
Tick_Unit, {X-coordinate of first grid line to right of origin}
Pix_per_Unit: real; {Number of pixels in one grid unit}
NumStr: Str7; {String form of grid labels}
begin
Clear_Screen;
if Res = Hi then
Line_Color(Black)
else
Line_Color(Red);
Pix_per_Unit := X_Center/5;
{ Vertical grid lines }
SY1 := 0;
SY2 := Y_Pix - 1;
for X := -5 to 4 do begin
SX1 := X_Center + X*Pix_per_Unit;
Line(round(SX1),round(SY1),round(SX1),round(SY2))
end; {for}
SX1 := X_Pix - 1;
Line(round(SX1),round(SY1),round(SX1),round(SY2));
{ Horizontal grid lines }
SX1 := 0;
SX2 := X_Pix - 1;
for Y := -3 to 3 do begin
SY1 := Y_Center - Y*SF*Pix_per_Unit;
Line(round(SX1),round(SY1),round(SX2),round(SY1))
end; {for}
Line_Color(Black);
Line(X_Center,0,X_Center,Y_Pix-1);
Line(0,Y_Center,X_Pix-1,Y_Center);
{ X-axis labels }
Draw_Mode(2);
Tick_Unit := X_Scale;
SY1 := Y_Center + 0.3*SF*Pix_per_Unit;
if Grid = Rectangular then
for X := 1 to 4 do begin
Num_to_Str(X*Tick_Unit, NumStr);
SX1 := X_Center + X*Pix_per_Unit - 8*Length(NumStr)/2;
Draw_String(round(SX1),round(SY1),NumStr);
SX1 := X_Center - X*Pix_per_Unit - 8*(Length(NumStr)+1)/2;
NumStr := concat('-',NumStr);
Draw_String(round(SX1),round(SY1),NumStr)
end {for}
else begin { Trigonometric X-axis labels }
NumStr:= chr(Pi_code);
SX1 := X_Center + 2*Pix_per_Unit - 4;
Draw_String(round(SX1),round(SY1),NumStr);
SX1 := X_Center - 2*Pix_per_Unit - 8;
NumStr := concat('-', NumStr);
Draw_String(round(SX1),round(SY1), NumStr);
delete(NumStr,1,1);
NumStr := concat('2',NumStr);
SX1 := X_Center + 4*Pix_per_Unit - 8;
Draw_String(round(SX1),round(SY1),NumStr);
SX1 := X_Center - 4*Pix_per_Unit - 16;
NumStr := concat('-', NumStr);
Draw_String(round(SX1),round(SY1), NumStr);
delete(NumStr,1,2);
NumStr := concat(NumStr, '/2');
SX1 := X_Center + Pix_per_Unit - 12;
Draw_String(round(SX1),round(SY1),NumStr);
SX1 := X_Center - Pix_per_Unit - 16;
NumStr := concat('-', NumStr);
Draw_String(round(SX1),round(SY1), NumStr);
delete(NumStr,1,1);
NumStr := concat('3',NumStr);
SX1 := X_Center + 3*Pix_per_Unit - 16;
Draw_String(round(SX1),round(SY1),NumStr);
SX1 := X_Center - 3*Pix_per_Unit - 20;
NumStr := concat('-', NumStr);
Draw_String(round(SX1),round(SY1), NumStr)
end; {else}
{ Y-Axis labels }
Tick_Unit := Y_Scale;
SX1 := X_Center + 8;
for Y := 1 to 3 do begin
Num_to_Str(Y*Tick_Unit, NumStr);
SY1 := Y_Center - Y*SF*Pix_per_Unit + 4*(Y_Pix DIV 200);
Draw_String(round(SX1),round(SY1),NumStr);
SY1 := Y_Center + Y*SF*Pix_per_Unit + 4*(Y_Pix DIV 200);
NumStr := concat('-',NumStr);
Draw_String(round(SX1),round(SY1),NumStr)
end; {for}
Draw_Mode(1)
end; {Draw_RGrid}
{----- Rect_Graph begins here -----}
begin
if Draw = ReDraw then
Rect_Grid(X_Scale, Y_Scale, Grid)
else if Draw = Old_Grid then
Restore_Screen(Display_Area, Temp_Screen)
else
Clear_Screen;
Line_Color(Graph_Color);
XPix_per_Unit := (X_Center/5)/X_Scale;
YPix_per_Unit := SF*(X_Center/5)/Y_Scale;
Line_to_Flag := FALSE;
for SX := 0 to X_Pix - 1 do begin
X := (SX - X_Center)/XPix_per_Unit;
Y := Evaluate(The_Function, X, Dummy, Undefined);
if NOT Undefined then begin
SY := Y_Center - Y*YPix_per_Unit;
if Abs(SY) < 32000 then { it's safe to use round function }
if Line_to_Flag then
Line_to(SX, round(SY))
else begin
Plot(SX, round(SY));
Line_to_Flag := TRUE
end {else}
else
Line_to_Flag := FALSE
end {if}
else
Line_to_Flag := FALSE
end {for}
end; {Draw_RGraph}
{************* Draw Polar Graph ***************
* *
* Draws a graph using a polar coordinate *
* system. *
* *
* Called by: MAIN DRIVER *
* *
* In parameters: Function being graphed, *
* Grid scale, Color of graph, *
* Grid drawing option *
* *
* Globals accessed: X_Center, Y_Center, X_Pix, *
* SF, Display_Area and *
* Temp_Screen *
************************************************}
procedure Polar_Graph(The_Function {in}: NodePtr;
X_Scale {in}: real;
Graph_Color {in}: integer;
Draw {in}: Draw_Type);
var
SX, SY, {Screen coordinates}
Angle, {Angle in radians}
Radius, {Radius for given angle}
XPix_per_Unit, {Pixels per horizontal grid unit}
YPix_per_Unit: real; {Pixels per vertical grid unit}
A: integer; {Loop counter}
Dummy_flag,
Undefined, {TRUE if function is undefined for given angle}
Line_to_Flag: boolean; {TRUE if last logical point was plotted}
Dummy:char;
{-------------- Draw Polar Grid --------------
| |
| Draws and labels a Polar coordinate grid. |
| |
| Called by: Polar_Graph |
| |
| In_Parameter: Grid scale |
| |
| Global variables accessed: Res, X_Pix, |
| Y_Pix, X_Center, Y_Center, SF |
-----------------------------------------------}
procedure Polar_Grid(X_Scale {in}: real);
var
Pix_per_Unit: real;
R: integer;
A: integer;
Rad: real;
SX1, SY1, SX2, SY2: real;
Temp: real;
X,Y: real;
NumStr: Str7;
begin
Clear_Screen;
if Res = Hi then
Line_Color(Black)
else
Line_Color(Red);
{ Draw the concentric circles. }
Pix_per_Unit := X_Center/5;
for R := 1 to 4 do begin
Plot(X_Center+round(Pix_per_Unit*R), Y_Center);
for A := 1 to 72 do begin
Rad := A*Pi/36;
Temp := R*Cos(Rad)*Pix_per_Unit;
SX1 := X_Center + Temp;
Temp := R*Sin(Rad)*SF*Pix_per_Unit;
SY1 := Y_Center - Temp;
Line_to(round(SX1), round(SY1))
end {for}
end; {for}
{ Draw radiating lines. Lines at 0, 30, 60,... degrees go through the
origin. The rest start at the second circle. Otherwise the middle
of the grid gets too cluttered. }
for A := 0 to 35 do begin
Rad := A*Pi/36;
X := 4*Cos(Rad)*Pix_per_Unit;
Y := 4*Sin(Rad)*SF*Pix_per_Unit;
if A MOD 3 = 0 then begin
SX1 := X_Center + X;
SY1 := Y_Center - Y;
SX2 := X_Center - X;
SY2 := Y_Center + Y;
Line(round(SX1), round(SY1), round(SX2), round(SY2))
end {if}
else begin
SX1 := X_Center + X;
SY1 := Y_Center - Y;
SX2 := X_Center + X/2;
SY2 := Y_Center - Y/2;
Line(round(SX1), round(SY1), round(SX2), round(SY2));
SX1 := X_Center - X;
SY1 := Y_Center + Y;
SX2 := X_Center - X/2;
SY2 := Y_Center + Y/2;
Line(round(SX1), round(SY1), round(SX2), round(SY2))
end {else}
end; {for}
{ Draw X-axis labels. }
Draw_Mode(2);
SY1 := Y_Center + 0.3*SF*Pix_per_Unit;
for R := 1 to 4 do begin
Num_to_Str(R*X_Scale, NumStr);
SX1 := X_Center + R*Pix_per_Unit-8*Length(NumStr)/2;
Draw_String(round(SX1), round(SY1), NumStr)
end; {for}
{ Draw the angle labels. }
for A := 1 to 23 do begin
Rad := A*Pi/12;
if (A<6) or (A>18) then
SX1 := X_Center + 4.1*Cos(Rad)*Pix_per_Unit
else
SX1 := X_Center + 4.1*Cos(Rad)*Pix_per_Unit - 24;
Temp := Y_Pix DIV 200;
SY1 := Y_Center - 4*Sin(Rad)*(SF*Pix_per_Unit + Temp) + 4*Temp;
Num_to_Str(15*A, NumStr);
Draw_String(round(SX1), round(SY1), NumStr)
end; {for}
Draw_Mode(1)
end; {Draw_PGrid}
{----- Polar_Graph begins here -----}
begin
if Draw = ReDraw then
Polar_Grid(X_Scale)
else if Draw = Old_Grid then
Restore_Screen(Display_Area, Temp_Screen)
else
Clear_Screen;
Line_Color(Graph_Color);
XPix_per_Unit := (X_Center/5)/X_Scale;
YPix_per_Unit := SF*XPix_per_Unit;
Line_to_Flag := FALSE;
A := 0;
{ Since polar graphs don't have a fixed 'stopping' place, the program
will continue plotting until the user presses a key. The screen
display will remain until the user presses another key. }
repeat
Angle := A*Pi/180;
Radius := Evaluate(The_Function, Angle, Dummy_flag, Undefined);
if NOT Undefined then begin
SX := X_Center + Radius*Cos(Angle)*XPix_per_Unit;
SY := Y_Center - Radius*Sin(Angle)*YPix_Per_Unit;
if Abs(SY) < 32000 then
if Line_to_Flag then
Line_to(round(SX), round(SY))
else begin
Plot(round(SX), round(SY));
Line_to_Flag := TRUE
end {else}
else
Line_to_Flag := FALSE
end {if}
else
Line_to_Flag := FALSE;
A := A + 1;
if A > 32000 then begin
A := 0;
Line_to_Flag := FALSE
end {if}
until keypress;
read(Dummy)
end; {Draw_PGraph}
{*************** Save Screen ******************
* *
* Save screen display. *
* *
* Called by: MAIN DRIVER *
* *
* In parameter: Pointer to physical screen *
* Out parameter: Screen storage area *
************************************************}
procedure Save_Screen(Display {in}: Screen_Ptr;
var Temp_Screen {out}: Screen_Ptr);
var
I: integer; {Loop control}
begin
{$P-}
for I := 0 to 31999 do
Temp_Screen^[I] := Display^[I]
{$P+}
end; {Save_Screen}
{-----------------------------------------
M A I N D R I V E R
-----------------------------------------}
begin
if Init_Gem >= 0 then begin
Hide_Mouse;
Initialization;
Get_Expression(Infix, PostFix);
while InFix <> 'Q' do begin
{ Get the parameter values desired by the user. }
while Get_Graph_Parameters_OK(Grid,X_Scale,Y_Scale,Color,Draw) do begin
if (Grid = Rectangular) or (Grid = Trigonometric) then
Rect_Graph(PostFix,X_Scale,Y_Scale,Color,Draw)
else
Polar_Graph(PostFix,X_Scale,Color,Draw);
{ Freeze display until user presses a key. }
repeat
Event := Get_Event(E_Button|E_Keyboard,1,1,1,0,FALSE,0,0,0,0,
FALSE,0,0,0,0,DummyMsg,D,D,D,D,D,D);
until (Event = E_Button) or (Event = E_Keyboard);
{ Save the screen display. }
Save_Screen(Display_Area, Temp_Screen)
end; {while}
{ Return postfix storage to the available memory heap. }
while PostFix <> NIL do begin
TempPtr := PostFix;
PostFix := PostFix^.Link;
dispose(TempPtr)
end; {while}
{ Get ready to do it again. }
Get_Expression(Infix, PostFix)
end; {while}
Show_Mouse;
Exit_Gem
end {if}
end.
